Assignment

Import Data

crowdfunding<-read.csv( "forqrm.csv" ,header=1)
head(crowdfunding)

library(lmtest)
rownames(crowdfunding)<-crowdfunding$State

Find Topics

1.Geography information

1. Geography information:found the significally different by state/by region

• Amount
• successfull rate within graphy/plot

2. Factors analysis:

2. factors:studying the relationship between Successful Rate and other factors:

• Higher Eduction:pAdDeg;
• Ginicoeff # average_pledged_amount_of_Grand.Total#

3. Total regression

summary(lm(crowdfunding$count_of_Grand.Total~crowdfunding$Pop2010))#significant:0.0353

Call:
lm(formula = crowdfunding$count_of_Grand.Total ~ crowdfunding$Pop2010)

Residuals:
    Min      1Q  Median      3Q     Max 
-696.93  -96.93   -0.61   74.90 1418.91 

Coefficients:
                       Estimate Std. Error t value Pr(>|t|)    
(Intercept)          -1.129e+02  5.125e+01  -2.203   0.0325 *  
crowdfunding$Pop2010  5.039e-05  5.569e-06   9.048 6.03e-12 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 268 on 48 degrees of freedom
Multiple R-squared:  0.6304,    Adjusted R-squared:  0.6227 
F-statistic: 81.87 on 1 and 48 DF,  p-value: 6.028e-12

Geography information

Geography information-preprocess:kmean

hc<-hclust(dist(crowdfunding),method = "ward.D", members = NULL)

NAs introduced by coercion

plclust(hc)

'plclust' is deprecated.
Use 'plot' instead.
See help("Deprecated")

rect.hclust(hc,k=4)

heatmap(as.matrix(dist(crowdfunding,method= 'euclidean')),labRow = F, labCol = F)

NAs introduced by coercion

result<-cutree(hc,k=4)
result.category<-as.data.frame(result)
colnames(result.category)<-c("MDS_Category")
result.category

pie(result)

barplot(result,col =result )

#table(result)
#summary(result)
plot(result,type = "p",col=result,xlab="State",xaxt="n",ylab="MDS_Category")

library(ggplot2)
mds2 <- -cmdscale(dist(crowdfunding))

NAs introduced by coercion

plot(mds2, type="n", axes=FALSE, ann=FALSE)
text(mds2, labels=rownames(mds2), xpd = NA)

mds<-cmdscale(dist(crowdfunding),k=4,eig=T)

NAs introduced by coercion

x = mds$points[,1]
y = mds$points[,2]
p=ggplot(data.frame(x,y),aes(x,y))
p+geom_point(size=5 , alpha=0.8 , aes(colour=factor(result) ))

k2<-kmeans(all,centers=5,nstart=10)
summary(k2)

             Length Class  Mode   
cluster       49    -none- numeric
centers      225    -none- numeric
totss          1    -none- numeric
withinss       5    -none- numeric
tot.withinss   1    -none- numeric
betweenss      1    -none- numeric
size           5    -none- numeric
iter           1    -none- numeric
ifault         1    -none- numeric

Geography Information-simpleplot

par(mfrow=c(1,2) )
#count_of_Grand.Total
plot(crowdfunding$count_of_Grand.Total,col=crowdfunding$Region, main="Count of Project  Plot",ylab="Successful Rate",xaxt="n",xlab="State")
#axis(side=1,at=c(1,2,3,4,5,6,7,8),labels=c(crowdfunding$State))
legend("center",legend = levels(crowdfunding$Region),cex = 0.8, pch = 1,col=1:4)

#successful.rate
plot(crowdfunding$successful.rate,col=crowdfunding$Region, main="Successful Rate Plot",ylab="Successful Rate",xaxt="n",xlab="State")
#axis(side=1,at=c(1,2,3,4,5,6,7,8),labels=c(crowdfunding$State))
legend("bottomleft",legend = levels(crowdfunding$Region),cex = 0.8, pch = 1,col=1:4)

Geography information-boxplot

par(mfrow=c(1,3))
#Boxplot for successful.rate and count_of_Grand.Total
#count_of_Grand.Total
boxplot(crowdfunding$count_of_Grand.Total[crowdfunding$Region=="Midwest"],crowdfunding$count_of_Grand.Total[crowdfunding$Region=="Northeast"],crowdfunding$count_of_Grand.Total[crowdfunding$Region=="South"],crowdfunding$count_of_Grand.Total[crowdfunding$Region=="West"],names=levels(crowdfunding$Region),main="Count of Projects BoxPlot by Region")
boxplot(log(crowdfunding$count_of_Grand.Total[crowdfunding$Region=="Midwest"]),log(crowdfunding$count_of_Grand.Total[crowdfunding$Region=="Northeast"]),log(crowdfunding$count_of_Grand.Total[crowdfunding$Region=="South"]),log(crowdfunding$count_of_Grand.Total[crowdfunding$Region=="West"]),names=levels(crowdfunding$Region),main="log Count of Projects BoxPlot by Region")

#successful.rate
boxplot(crowdfunding$successful.rate[crowdfunding$Region=="Midwest"],crowdfunding$successful.rate[crowdfunding$Region=="Northeast"],crowdfunding$successful.rate[crowdfunding$Region=="South"],crowdfunding$successful.rate[crowdfunding$Region=="West"],names=levels(crowdfunding$Region),main="Successful Rate BoxPlot by Region")

Geography information-t.test

p=NULL
temp<-NULL
for (location1 in 1:4){
  for (location2 in 1:4){
    if (1){
      temp<-t.test(crowdfunding$successful.rate[crowdfunding$MDS_Category==location1],crowdfunding$successful.rate[crowdfunding$MDS_Category==location2])
      if(temp$p.value<=0.1){
        print(c(location1,location2,temp$p.value))
      }
      p<-c(p,temp$p.value)}}}
MDSR.t.test.p.vlaue<-as.data.frame(matrix(p,4,4),row.names = c(1:4))
colnames(MDSR.t.test.p.vlaue)<-c(1:4)
print("Successful Rate by Region")

[1] "Successful Rate by Region"

MDSR.t.test.p.vlaue

Factors analysis

This article is to analyse the factors to the crowdfunding successful rate. I guess the Education, the inequity of family income and the poverty rate may be related to the crowdfunding successful rate. and in the follow context, i will analyse the those factors.

Firstly, The Statistical Summary ### Factors Analysis-Statistical Summary

library(moments)
summary(crowdfunding$successful.rate)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 0.1250  0.3179  0.3636  0.3631  0.4095  0.5484 

kurtosis(crowdfunding$successful.rate)

[1] 3.630147

summary(crowdfunding$GiniCoeff)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 0.4190  0.4400  0.4530  0.4522  0.4658  0.4990 

kurtosis(crowdfunding$GiniCoeff)

[1] 2.552647

summary(crowdfunding$pAdDeg)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
0.06100 0.07950 0.09200 0.09794 0.11000 0.16400 

kurtosis(crowdfunding$pAdDeg)

[1] 3.382781

summary(crowdfunding$PovRate1)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 0.0920  0.1212  0.1480  0.1480  0.1705  0.2190 

kurtosis(crowdfunding$PovRate1)

[1] 2.159154

Factors Analysis-Plot for Factors

boxplot(crowdfunding$successful.rate,crowdfunding$GiniCoeff,crowdfunding$pAdDeg,crowdfunding$PovRate1,names = c("Successful Rate","GiniCoeff","Higher Education","PovRate1"),main="Factors Box Plot")
par(mfrow=c(1,3))

plot(crowdfunding$successful.rate,col="red",pch=10,xlab="State",ylab="Successful Rate",xaxt="n",main="Successful Rate Plot")
plot(crowdfunding$GiniCoeff,col="green",pch=18,xlab="State",xaxt="n",ylab="GiniCoeff ",xaxt="n",main="GiniCoeff Plot")

plot(crowdfunding$pAdDeg,col="blue",pch=15,xlab="State",xaxt="n",ylab="Adanced Education Rate",xaxt="n",main="Adanced Education Rate Plot")

#plot(crowdfunding$PovRate1,col="black",pch=16,xlab="State",xaxt="n",ylab="Poverty Rate",xaxt="n",main="Poverty Rate Plot")

library(car)
scatterplot(crowdfunding$successful.rate,log(crowdfunding$average_of_goal_Grand.Total),pch=19)

scatterplot(crowdfunding$successful.rate~crowdfunding$GiniCoeff,pch=19)

scatterplot(crowdfunding$successful.rate~crowdfunding$PovRate1,pch=19)

scatterplot(crowdfunding$successful.rate~crowdfunding$Densitym2,pch=19)

scatterplot(crowdfunding$successful.rate~crowdfunding$pHigh,pch=19)

scatterplot(crowdfunding$successful.rate~crowdfunding$pBatDeg,pch=19)

scatterplot(crowdfunding$successful.rate~crowdfunding$pAdDeg,pch=19)

Factors Analysis-Successful Rate|PovRate1

#redo scatterplot with Successful Rate-PovRate1
scatterplot(crowdfunding$successful.rate,crowdfunding$PovRate1,pch=19)

anova(successful.rate2PovRate1)

Analysis of Variance Table

Response: crowdfunding$successful.rate
                      Df  Sum Sq   Mean Sq F value Pr(>F)
crowdfunding$PovRate1  1 0.01157 0.0115683  1.4698 0.2313
Residuals             48 0.37780 0.0078708               

ggplot(crowdfunding,aes(x=PovRate1,y=successful.rate,main = "Successful rate~PovRate"))+geom_point(aes(col=Region))+geom_smooth(method = "loess")
par(mfrow=c(1,2))

boxplot(crowdfunding$successful.rate,crowdfunding$PovRate1,names=c("Successful Rate","PovRate1"))
boxplot(crowdfunding$successful.rate[crowdfunding$PovRate1>mean(crowdfunding$PovRate1)],crowdfunding$successful.rate[crowdfunding$PovRate1<=mean(crowdfunding$PovRate1)],col = c("green","deepskyblue"),names=c("Successful%(High PovRate)","Successful%(Low PovRate)"),xlab="Successful rate by PovRate1")

t.test(crowdfunding$successful.rate[crowdfunding$PovRate1>mean(crowdfunding$PovRate1)],crowdfunding$successful.rate[crowdfunding$PovRate1<=mean(crowdfunding$PovRate1)])

    Welch Two Sample t-test

data:  crowdfunding$successful.rate[crowdfunding$PovRate1 > mean(crowdfunding$PovRate1)] and crowdfunding$successful.rate[crowdfunding$PovRate1 <= mean(crowdfunding$PovRate1)]
t = -0.01904, df = 43.704, p-value = 0.9849
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 -0.05105839  0.05010288
sample estimates:
mean of x mean of y 
0.3628157 0.3632935 

plot(crowdfunding$PovRate1,crowdfunding$successful.rate,pch=19,col=crowdfunding$Region,ylab="Successful Rate",xlab="PovRate1",main="Successful Rate-PovRate1 Plot with lowess line")
points(lowess(crowdfunding$PovRate1,crowdfunding$successful.rate,f=1/3),pch=4,col="orange",type="l")

#abline(lm(crowdfunding$successful.rate~crowdfunding$PovRate1),col="orange")
legend("bottomright",legend = levels(crowdfunding$Region),cex = 0.8, pch = 19,col=1:4)
qqplot(crowdfunding$PovRate1,crowdfunding$successful.rate,pch=1,col=crowdfunding$Region,main="QQ plot: (Successful Rate & PovRate)")

qqline(crowdfunding$PovRate1 ,crowdfunding$successful.rate,col="red")

the condition has length > 1 and only the first element will be used

legend("topleft",legend = levels(crowdfunding$Region), pch = 19,col=1:3)

par(mfrow=c(1,1))

#qqnorm(crowdfunding$successful.rate,col=crowdfunding$Region,xlab="Successful Rate")
#qqline(crowdfunding$successful.rate,col="red")
qqnorm(crowdfunding$PovRate1,col=crowdfunding$Region,pch=18,xlab ="PovRate1")
qqline(crowdfunding$PovRate1,col="red")

Factors Analysis-Successful Rate|GiniCoeff

ggplot(crowdfunding,aes(x=GiniCoeff,y=successful.rate,main = "Successful rate~GiniCoeff"))+geom_point(aes(col=Region))+geom_smooth(method = "loess")
anova(successful.rate2GiniCoeff)

Analysis of Variance Table

Response: crowdfunding$successful.rate
                       Df  Sum Sq  Mean Sq F value   Pr(>F)   
crowdfunding$GiniCoeff  1 0.06236 0.062361  9.1537 0.003981 **
Residuals              48 0.32701 0.006813                    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

par(mfrow=c(1,2))

boxplot(crowdfunding$successful.rate,crowdfunding$GiniCoeff,names=c("Successful rate","GiniCoeff"))
boxplot(crowdfunding$successful.rate[crowdfunding$GiniCoeff>mean(crowdfunding$GiniCoeff)],crowdfunding$successful.rate[crowdfunding$GiniCoeff<=mean(crowdfunding$GiniCoeff)],col = c("darkorchid2","dodgerblue"),names=c("Successful%(High GiniCoeff)","Successful%(Low GiniCoeff)"),xlab="Successful rate by GiniCoeff")

t.test(crowdfunding$successful.rate[crowdfunding$GiniCoeff>mean(crowdfunding$GiniCoeff)],crowdfunding$successful.rate[crowdfunding$GiniCoeff<=mean(crowdfunding$GiniCoeff)])

    Welch Two Sample t-test

data:  crowdfunding$successful.rate[crowdfunding$GiniCoeff > mean(crowdfunding$GiniCoeff)] and crowdfunding$successful.rate[crowdfunding$GiniCoeff <= mean(crowdfunding$GiniCoeff)]
t = 1.6383, df = 43.111, p-value = 0.1086
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 -0.009375926  0.090607105
sample estimates:
mean of x mean of y 
0.3833720 0.3427564 

plot(crowdfunding$successful.rate,crowdfunding$GiniCoeff,f=1/3 ,pch=19,col="blue",xlab="Successful Rate",ylab="GiniCoeff",main="Successful Rate-GiniCoeff Plot with lowess line")
points(lowess(crowdfunding$successful.rate,crowdfunding$GiniCoeff,f=1/3),pch=4,col="red",type="l")

qqplot(crowdfunding$successful.rate,crowdfunding$GiniCoeff,pch=19,col="red",main="Q-Q Plot: Successful Rate-GiniCoeff")
qqline(crowdfunding$successful.rate,crowdfunding$GiniCoeff)

the condition has length > 1 and only the first element will be used

#qqnorm(crowdfunding$successful.rate,col="orange",xlab="Successful Rate")
#qqline(crowdfunding$successful.rate,col="red")
par(mfrow=c(1,1))

qqnorm(crowdfunding$GiniCoeff,col="blue",pch=20,xlab="GiniCoeff")
qqline(crowdfunding$GiniCoeff,col="red")

Factors Analysis-Successful Rate|Adanced Education

ggplot(crowdfunding,aes(x=pAdDeg,y=successful.rate,main = "Successful rate~GiniCoeff"))+geom_point(aes(col=Region))+geom_smooth(method = "loess")
anova(successful.rate2pAdDeg)

Analysis of Variance Table

Response: crowdfunding$successful.rate
                    Df  Sum Sq  Mean Sq F value   Pr(>F)   
crowdfunding$pAdDeg  1 0.05947 0.059469  8.6527 0.005015 **
Residuals           48 0.32990 0.006873                    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

par(mfrow=c(1,2))

boxplot(crowdfunding$successful.rate,crowdfunding$pAdDeg,names=c("Successful rate","Adanced Education"))
boxplot(crowdfunding$successful.rate[crowdfunding$pAdDeg>mean(crowdfunding$pAdDeg)],crowdfunding$successful.rate[crowdfunding$pAdDeg<=mean(crowdfunding$pAdDeg)],col = c("darkorchid2","dodgerblue"),names=c("Successful%(High Adanced Education)","Successful%(Low Adanced Education)"),xlab="Successful rate by Adanced Education")

t.test(crowdfunding$successful.rate[crowdfunding$pAdDeg>mean(crowdfunding$pAdDeg)],crowdfunding$successful.rate[crowdfunding$pAdDeg<=mean(crowdfunding$pAdDeg)])

    Welch Two Sample t-test

data:  crowdfunding$successful.rate[crowdfunding$pAdDeg > mean(crowdfunding$pAdDeg)] and crowdfunding$successful.rate[crowdfunding$pAdDeg <= mean(crowdfunding$pAdDeg)]
t = 3.5483, df = 45.573, p-value = 0.0009119
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 0.03480093 0.12610121
sample estimates:
mean of x mean of y 
0.4097258 0.3292747 

plot(crowdfunding$successful.rate,crowdfunding$pAdDeg,f=1/3 ,pch=19,col="blue",xlab="Successful Rate",ylab="Adanced Education",main="Successful Rate-Adanced Education Plot with lowess line")
points(lowess(crowdfunding$successful.rate,crowdfunding$pAdDeg,f=1/3),pch=4,col="red",type="l")

qqplot(crowdfunding$successful.rate,crowdfunding$pAdDeg,pch=19,col="red",main="Q-Q Plot: Successful Rate-Adanced Education")
qqline(crowdfunding$successful.rate,crowdfunding$pAdDeg)

the condition has length > 1 and only the first element will be used

#qqnorm(crowdfunding$successful.rate,col="orange",xlab="Successful Rate")
#qqline(crowdfunding$successful.rate,col="red")
par(mfrow=c(1,1))

qqnorm(crowdfunding$pAdDeg,col="blue",pch=20,xlab="Adanced Education")
qqline(crowdfunding$pAdDeg,col="red")